home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok21 / popmenu / popmenudemo.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  136 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     PopMenuDemo.mod
  3.     :Contents.      Demonstriert die Benutzung des Moduls PopMenu
  4.     :Author.      Bernd Preusing
  5.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  6.     :Phone.      04121/22486
  7.     :Copyright.      Public Domain
  8.     :Language.      Modula-2
  9.     :Translator.  M2Amiga V3.2e
  10.     :Support.      siehe PopMenu.def
  11.     :History.      V1.0 29-Apr-89
  12.     :Imports.      PopMenu V1.0 (Preusing) BackDrop V1.0 (Preusing)
  13. ---------------------------------------------------------------------------*)
  14. MODULE PopMenuDemo;
  15.  
  16. FROM SYSTEM    IMPORT    ADR;
  17. FROM Arts    IMPORT    Terminate, CurrentLevel, Requester, TermProcedure;
  18. FROM BackDrop    IMPORT    OpenBackDrop, BdRp, BdWindow, BdScreen;
  19. FROM PopMenu    IMPORT    PopUpMenu, PopUpItem, StructPopUp, AddItem,
  20.             InitPopUp, PopUp, DisposePopUp,
  21.             NOITEMSELECTED, OUTSIDEWINDOW;
  22. FROM Exec    IMPORT    GetMsg, ReplyMsg, WaitPort;
  23. FROM Graphics    IMPORT    Move, SetAPen, Text, RectFill;
  24. FROM Intuition    IMPORT    IDCMPFlags, IDCMPFlagSet, WindowPtr, menuUp, menuDown,
  25.             selectUp, selectDown,
  26.             WindowFlags, IntuiMessage, IntuiMessagePtr,
  27.             ModifyIDCMP, ScreenToFront, ActivateWindow;
  28. FROM Str    IMPORT    Length;
  29.  
  30. CONST
  31.     DEPTH = 2;
  32.  
  33. VAR
  34.     StartLevel: INTEGER;
  35.     LeftMenu, RightMenu: PopUpMenu;
  36.     LeftItems: ARRAY[1..3] OF PopUpItem;
  37.     RightItems: ARRAY[1..5] OF PopUpItem;
  38.  
  39.  
  40. PROCEDURE ButtonLoop;
  41.  
  42.   PROCEDURE WriteL(s: ARRAY OF CHAR);
  43.   BEGIN
  44.     SetAPen(BdRp,1);
  45.     RectFill(BdRp,0,100,640,130);
  46.     Move(BdRp,10,115);
  47.     SetAPen(BdRp,2);
  48.     Text(BdRp,ADR(s),Length(s));
  49.   END WriteL;
  50.  
  51. VAR Action:INTEGER;
  52.     i: IntuiMessagePtr;
  53.     TempMsg: IntuiMessage;
  54. BEGIN (* ButtonLoop *)
  55.   LOOP (* endlos *)
  56.     WaitPort(BdWindow^.userPort);
  57.     i:=GetMsg(BdWindow^.userPort);
  58.     TempMsg:=i^;
  59.     ReplyMsg(i);
  60.     WITH TempMsg DO
  61.       IF (class=IDCMPFlagSet{mouseButtons}) AND (code=menuDown) THEN
  62.         Action:=PopUp(RightMenu,BdWindow);
  63.         CASE Action OF
  64.         | 1: WriteL('Rechts 1');
  65.         | 2: WriteL('Rechts 2');
  66.         | 3: WriteL('Rechts 3');
  67.         | 4: WriteL('Rechts 4');
  68.         | 5: IF Requester(ADR('You want to'),ADR('QUIT?'),
  69.                   ADR('Yes'),ADR('No')) THEN
  70.                   Terminate(CurrentLevel());
  71.                ELSE
  72.                  ScreenToFront(BdScreen); (* Workbench nach hinten *)
  73.                  ActivateWindow(BdWindow);
  74.              END;
  75.         | OUTSIDEWINDOW: WriteL('OutSideWindow');
  76.         | NOITEMSELECTED: WriteL('No Item selected');
  77.         END;
  78.       ELSIF (class=IDCMPFlagSet{mouseButtons}) AND (code=selectDown) THEN
  79.         Action:=PopUp(LeftMenu,BdWindow);
  80.         CASE Action OF
  81.         | 1: WriteL('Links 1');
  82.         | 2: WriteL('Links 2');
  83.         | 3: WriteL('Links 3');
  84.         | OUTSIDEWINDOW: WriteL('OutSideWindow');
  85.         | NOITEMSELECTED: WriteL('No Item selected');
  86.         END;
  87.       ELSE
  88.         WriteL('unbekannter IDCMP');
  89.       END;
  90.     END; (* with TempMsg *)
  91.   END; (* endless loop *)
  92. END ButtonLoop;
  93.  
  94. PROCEDURE Exit;
  95. BEGIN
  96.   IF CurrentLevel()<=StartLevel THEN
  97.     DisposePopUp(LeftMenu);
  98.     DisposePopUp(RightMenu);
  99.   END
  100. END Exit;
  101.  
  102. PROCEDURE Init;
  103. BEGIN
  104.   StartLevel:=CurrentLevel();
  105.   TermProcedure(Exit);
  106.  
  107.   OpenBackDrop(DEPTH,640,256-12,
  108.       ADR('PopUpMenuDemo © BP 4/89.  Linke oder rechte Maustaste!'));
  109.   
  110.   (* Rechtes Menü initialisieren: *)
  111.   StructPopUp(RightMenu,DEPTH,3,2);
  112.   AddItem(RightMenu,RightItems[1],ADR('Erster'),           1,1);
  113.   AddItem(RightMenu,RightItems[2],ADR('Zweiter'),          2,1);
  114.   AddItem(RightMenu,RightItems[3],ADR('Dritter'),          3,1);
  115.   AddItem(RightMenu,RightItems[4],ADR('Viertens oder was'),4,0);
  116.   AddItem(RightMenu,RightItems[5],ADR('      Ende'),       5,3);
  117.   RightItems[5].top:=5;
  118.   InitPopUp(RightMenu);
  119.   RightMenu.deactivate:=menuUp;
  120.   INCL(BdWindow^.flags,rmbTrap);
  121.  
  122.  
  123.   StructPopUp(LeftMenu,DEPTH,1,0);
  124.   AddItem(LeftMenu,LeftItems[1],ADR('11111111'),        1,2);
  125.   AddItem(LeftMenu,LeftItems[2],ADR('2222222222222222'),2,2);
  126.   AddItem(LeftMenu,LeftItems[3],ADR('333333'),          3,3);
  127.   InitPopUp(LeftMenu);
  128.  
  129.   ModifyIDCMP(BdWindow,IDCMPFlagSet{mouseButtons});
  130. END Init;
  131.  
  132. BEGIN
  133.   Init;
  134.   ButtonLoop;
  135. END PopMenuDemo.
  136.